Ham Radio 2000/Ham Radio 2000.iso/ham2000/misc/icom_cat/program3.bas

BASIC Source File | 1993-07-30 | 6KB | 230 lines

'
' Program 1 (MODE AND VFO SETTING)
'
' Program taken from the "CT-17 Communication Interface-V (CI-V) Level
' Converter Instruction Manual". Program converted to IBM QBASIC by Bill
' Heaton, N7WRI.
'
DEFINT G-Z

DECLARE SUB DoCommand (Cmd AS INTEGER, Arg AS STRING)
DECLARE SUB GetReply ()
DECLARE SUB SetupBCD ()
DECLARE SUB SetupCOM ()
DECLARE SUB ShowMainPrompts ()

DECLARE FUNCTION GetChan$ ()
DECLARE FUNCTION STRTOHEX$ (Str AS STRING)

DIM SHARED BCD$(100)

'
' Configuration Information
'

CONST RA = &H3C                 ' Receive Address (IC-737)
CONST TA = &HE0                 ' Transmit Address (Computer)

CONST PORT$ = "COM1"            ' Serial Port to use
CONST PORTNO = 1                ' Serial Port to use
CONST CONF$ = "1200,N,8,1"      ' Baud rate, Parity, Bits, Stop Bits

CONST SHOWCOM = 1               ' Show Com Packets ( 0=No, 1=Yes)

'
' Initialize
'

SetupBCD
SetupCOM
ShowMainPrompts

'
'  Endless loop until an event handler kills us
'
DO UNTIL TRUE
LOOP

'
' Event Handlers
'
Serial: GetReply:           RETURN
F1: DoCommand &H8, "":      RETURN
F2: DoCommand &H8, GetChan$: RETURN
F3: DoCommand &H9, "":      RETURN
F4: DoCommand &HA, "":      RETURN
F5: DoCommand &HB, "":      RETURN
F6: DoCommand &HE, CHR$(1): RETURN
F7: DoCommand &HE, CHR$(0): RETURN
F0: CLOSE : SYSTEM

' +---------------------------------------------------------------------+
' |                                                                     |
' |                      ICOM CI-V Packet Layout                        |
' |     +----------+----------+---------+---------+---------+------+    |
' |     | Preamble | Transmit | Receive | Command | Sub     | EOM  |    |
' |     | <FE><FE> | Address  | Address |         | Command | <FD> |    |
' |     +----------+----------+---------+---------+---------+------+    |
' |                                                                     |
' |     A packet consists of two bytes of &HFE, one byte for the        |
' |     transmit address (Controller), One byte receive address         |
' |     (Rig), one byte command, one to five byte subcommand, and       |
' |     finally the tail of one byte of &HFD.                           |
' |                                                                     |
' +---------------------------------------------------------------------+
SUB DoCommand (Cmd AS INTEGER, SubCmd AS STRING)

  '
  ' Create the packet and send it out
  '
  Out$ = CHR$(&HFE) + CHR$(&HFE) + CHR$(RA) + CHR$(TA) + CHR$(Cmd) + SubCmd + CHR$(&HFD)
  PRINT #1, Out$;

  '
  ' If we're watching packets, send to the screen in hex
  '
  IF SHOWCOM THEN
    CLS
    LOCATE 17, 1: PRINT "Sent: "
    LOCATE 17, 7: PRINT STRTOHEX$(Out$);
    LOCATE 18, 1: PRINT "Echo: "
    LOCATE 19, 1: PRINT "Back: "
  END IF
END SUB

'
' Get a memory channel from the user
'
FUNCTION GetChan$
  I = 0
  WHILE I = 0
    CLS
    LOCATE 12, 30: INPUT "Enter Memory Channel: ", I
    IF I < 1 OR I > 9999 THEN I = 0
  WEND

  IF I < 100 THEN
    GetChan$ = BCD$(I)
  ELSE
    I$ = RIGHT$("0000" + MID$(STR$(I), 2), 4)
    DA$ = ""

    FOR K = 1 TO 4 STEP 2
      DA$ = DA$ + BCD$(VAL(MID$(I$, K, 2)))
    NEXT K
    GetChan$ = DA$
  END IF
END FUNCTION

'
' GetReply      - Character has arrived from rig, stuff it away until
'                 have an entire packet and display it.
'
SUB GetReply
  STATIC Hold$

  '
  ' Accumulate the Reply, if its not end of packet get out early
  '
  Hold$ = Hold$ + INPUT$(LOC(PORTNO), PORTNO)
  IF INSTR(Hold$, CHR$(&HFD)) = 0 THEN
    EXIT SUB
  END IF

  '
  ' Echo replys to the screen if we were told to
  '
  IF SHOWCOM THEN
    IF MID$(Hold$, 3, 1) = CHR$(TA) THEN
      LOCATE 19, 7: PRINT STRTOHEX$(Hold$);

      SELECT CASE MID$(Hold$, 5, 1)
        CASE CHR$(&HFB)
            LOCATE 25, 1: PRINT "[OK]     ";
        CASE CHR$(&HFA)
            LOCATE 25, 1: PRINT "[ERROR]  ";
        CASE ELSE
            LOCATE 25, 1: PRINT "[Unknown]";
      END SELECT
    ELSE
      LOCATE 18, 7: PRINT STRTOHEX$(Hold$);
    END IF
  END IF

  ' Get ready for next reply
  Hold$ = ""
END SUB

'
'  Set up the BCD string array
'
SUB SetupBCD
  FOR M = 0 TO 9
    FOR N = 0 TO 9
      BCD$(10 * M + N) = CHR$(16 * M + N)
    NEXT N
  NEXT M
END SUB

'
'  Setup the channel to the serial port
'
SUB SetupCOM

  OPEN PORT$ + ":" + CONF$ + ",CD0,CS0,DS0,OP0,RS" FOR RANDOM AS #1
  ON COM(PORTNO) GOSUB Serial
  COM(PORTNO) ON
END SUB

SUB ShowMainPrompts

  '
  '  Paint the prompts
  '
  CLS
  M1$ = "╔═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦══════╗"
  M2$ = "║  F1   ║  F2   ║  F3   ║  F4   ║  F5   ║  F6   ║  F7   ║       ║       ║ F10  ║"
  M3$ = "║ Memory║ Select║  MW   ║ M>VFO ║  MC   ║ Scan ║ Scan █║       ║       ║ EXIT ║"
  M4$ = "╚═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩══════╝"

  LOCATE 21, 1: PRINT M1$;
  LOCATE 22, 1: PRINT M2$;
  LOCATE 23, 1: PRINT M3$;
  LOCATE 24, 1: PRINT M4$;
  VIEW PRINT 1 TO 20

  '
  '  Setup function key handlers for each options
  '
  ON KEY(1) GOSUB F1
  ON KEY(2) GOSUB F2
  ON KEY(3) GOSUB F3
  ON KEY(4) GOSUB F4
  ON KEY(5) GOSUB F5
  ON KEY(6) GOSUB F6
  ON KEY(7) GOSUB F7
  ON KEY(10) GOSUB F0
  '
  '  Turn the key handlers on
  '
  FOR I = 1 TO 10
    KEY(I%) ON
  NEXT I

  KEY(8) OFF
  KEY(9) OFF
END SUB

' STRTOHEX$ - Translate all the characters in a string to hex and
'             return the resulting string.
'
FUNCTION STRTOHEX$ (Str AS STRING)
Scn$ = ""
FOR I = 1 TO LEN(Str)
     C$ = HEX$(ASC(MID$(Str, I, 1)))
     Scn$ = Scn$ + C$ + " "
  NEXT I
STRTOHEX$ = Scn$
END FUNCTION